home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / The GIMP 2.2.8 / gimp-2.2.8-i586-setup.exe / {app} / share / gimp / 2.0 / scripts / weave.scm < prev    next >
Encoding:
GIMP Script-Fu Script  |  2005-06-30  |  11.4 KB  |  407 lines
  1. ; The GIMP -- an image manipulation program
  2. ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
  3. ;
  4. ; Weave script --- make an image look as if it were woven
  5. ; Copyright (C) 1997 Federico Mena Quintero
  6. ; federico@nuclecu.unam.mx
  7. ;
  8. ; This program is free software; you can redistribute it and/or modify
  9. ; it under the terms of the GNU General Public License as published by
  10. ; the Free Software Foundation; either version 2 of the License, or
  11. ; (at your option) any later version.
  12. ;
  13. ; This program is distributed in the hope that it will be useful,
  14. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ; GNU General Public License for more details.
  17. ;
  18. ; You should have received a copy of the GNU General Public License
  19. ; along with this program; if not, write to the Free Software
  20. ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22.  
  23. ; Copies the specified rectangle from/to the specified drawable
  24.  
  25. (define (copy-rectangle img
  26.             drawable
  27.             x1
  28.             y1
  29.             width
  30.             height
  31.             dest-x
  32.             dest-y)
  33.   (gimp-rect-select img x1 y1 width height CHANNEL-OP-REPLACE FALSE 0)
  34.   (gimp-edit-copy drawable)
  35.   (let ((floating-sel (car (gimp-edit-paste drawable FALSE))))
  36.     (gimp-layer-set-offsets floating-sel dest-x dest-y)
  37.     (gimp-floating-sel-anchor floating-sel))
  38.   (gimp-selection-none img))
  39.  
  40. ; Creates a single weaving tile
  41.  
  42. (define (create-weave-tile ribbon-width
  43.                ribbon-spacing
  44.                shadow-darkness
  45.                shadow-depth)
  46.   (let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
  47.      (darkness (* 255 (/ (- 100 shadow-darkness) 100)))
  48.      (img (car (gimp-image-new tile-size tile-size RGB)))
  49.      (drawable (car (gimp-layer-new img tile-size tile-size RGB-IMAGE
  50.                     "Weave tile" 100 NORMAL-MODE))))
  51.     (gimp-image-undo-disable img)
  52.     (gimp-image-add-layer img drawable 0)
  53.  
  54.     (gimp-context-set-background '(0 0 0))
  55.     (gimp-edit-fill drawable BACKGROUND-FILL)
  56.  
  57.     ; Create main horizontal ribbon
  58.  
  59.     (gimp-context-set-foreground '(255 255 255))
  60.     (gimp-context-set-background (list darkness darkness darkness))
  61.  
  62.     (gimp-rect-select img
  63.               0
  64.               ribbon-spacing
  65.               (+ (* 2 ribbon-spacing) ribbon-width)
  66.               ribbon-width
  67.               CHANNEL-OP-REPLACE
  68.               FALSE
  69.               0)
  70.  
  71.     (gimp-edit-blend drawable FG-BG-RGB-MODE NORMAL-MODE
  72.              GRADIENT-BILINEAR 100 (- 100 shadow-depth) REPEAT-NONE FALSE
  73.              FALSE 0 0 TRUE
  74.              (/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2) 0 0 0)
  75.  
  76.     ; Create main vertical ribbon
  77.  
  78.     (gimp-rect-select img
  79.               (+ (* 2 ribbon-spacing) ribbon-width)
  80.               0
  81.               ribbon-width
  82.               (+ (* 2 ribbon-spacing) ribbon-width)
  83.               CHANNEL-OP-REPLACE
  84.               FALSE
  85.               0)
  86.  
  87.     (gimp-edit-blend drawable FG-BG-RGB-MODE NORMAL-MODE
  88.              GRADIENT-BILINEAR 100 (- 100 shadow-depth) REPEAT-NONE FALSE
  89.              FALSE 0 0 TRUE
  90.              0 (/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2) 0 0)
  91.  
  92.     ; Create the secondary horizontal ribbon
  93.  
  94.     (copy-rectangle img
  95.             drawable
  96.             0
  97.             ribbon-spacing
  98.             (+ ribbon-width ribbon-spacing)
  99.             ribbon-width
  100.             (+ ribbon-width ribbon-spacing)
  101.             (+ (* 2 ribbon-spacing) ribbon-width))
  102.  
  103.     (copy-rectangle img
  104.             drawable
  105.             (+ ribbon-width ribbon-spacing)
  106.             ribbon-spacing
  107.             ribbon-spacing
  108.             ribbon-width
  109.             0
  110.             (+ (* 2 ribbon-spacing) ribbon-width))
  111.  
  112.     ; Create the secondary vertical ribbon
  113.  
  114.     (copy-rectangle img
  115.             drawable
  116.             (+ (* 2 ribbon-spacing) ribbon-width)
  117.             0
  118.             ribbon-width
  119.             (+ ribbon-width ribbon-spacing)
  120.             ribbon-spacing
  121.             (+ ribbon-width ribbon-spacing))
  122.  
  123.     (copy-rectangle img
  124.             drawable
  125.             (+ (* 2 ribbon-spacing) ribbon-width)
  126.             (+ ribbon-width ribbon-spacing)
  127.             ribbon-width
  128.             ribbon-spacing
  129.             ribbon-spacing
  130.             0)
  131.  
  132.     ; Done
  133.  
  134.     (gimp-image-undo-enable img)
  135.  
  136.     (list img drawable)))
  137.  
  138. ; Creates a complete weaving mask
  139.  
  140. (define (create-weave width
  141.               height
  142.               ribbon-width
  143.               ribbon-spacing
  144.               shadow-darkness
  145.               shadow-depth)
  146.   (let* ((tile (create-weave-tile ribbon-width ribbon-spacing shadow-darkness
  147.                   shadow-depth))
  148.      (tile-img (car tile))
  149.      (tile-layer (cadr tile))
  150.       (weaving (plug-in-tile 1 tile-img tile-layer width height TRUE)))
  151.     (gimp-image-delete tile-img)
  152.     weaving))
  153.  
  154. ; Creates a single tile for masking
  155.  
  156. (define (create-mask-tile ribbon-width
  157.               ribbon-spacing
  158.               r1-x1
  159.               r1-y1
  160.               r1-width
  161.               r1-height
  162.               r2-x1
  163.               r2-y1
  164.               r2-width
  165.               r2-height
  166.               r3-x1
  167.               r3-y1
  168.               r3-width
  169.               r3-height)
  170.   (let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
  171.      (img (car (gimp-image-new tile-size tile-size RGB)))
  172.      (drawable (car (gimp-layer-new img tile-size tile-size RGB-IMAGE
  173.                     "Mask" 100 NORMAL-MODE))))
  174.     (gimp-image-undo-disable img)
  175.     (gimp-image-add-layer img drawable 0)
  176.  
  177.     (gimp-context-set-background '(0 0 0))
  178.     (gimp-edit-fill drawable BACKGROUND-FILL)
  179.  
  180.     (gimp-rect-select img r1-x1 r1-y1 r1-width r1-height CHANNEL-OP-REPLACE FALSE 0)
  181.     (gimp-rect-select img r2-x1 r2-y1 r2-width r2-height CHANNEL-OP-ADD FALSE 0)
  182.     (gimp-rect-select img r3-x1 r3-y1 r3-width r3-height CHANNEL-OP-ADD FALSE 0)
  183.  
  184.     (gimp-context-set-background '(255 255 255))
  185.     (gimp-edit-fill drawable BACKGROUND-FILL)
  186.     (gimp-selection-none img)
  187.  
  188.     (gimp-image-undo-enable img)
  189.  
  190.     (list img drawable)))
  191.  
  192. ; Creates a complete mask image
  193.  
  194. (define (create-mask final-width
  195.              final-height
  196.              ribbon-width
  197.              ribbon-spacing
  198.              r1-x1
  199.              r1-y1
  200.              r1-width
  201.              r1-height
  202.              r2-x1
  203.              r2-y1
  204.              r2-width
  205.              r2-height
  206.              r3-x1
  207.              r3-y1
  208.              r3-width
  209.              r3-height)
  210.   (let* ((tile (create-mask-tile ribbon-width ribbon-spacing
  211.                  r1-x1 r1-y1 r1-width r1-height
  212.                  r2-x1 r2-y1 r2-width r2-height
  213.                  r3-x1 r3-y1 r3-width r3-height))
  214.      (tile-img (car tile))
  215.      (tile-layer (cadr tile))
  216.      (mask (plug-in-tile 1 tile-img tile-layer final-width final-height
  217.                  TRUE)))
  218.     (gimp-image-delete tile-img)
  219.     mask))
  220.  
  221. ; Creates the mask for horizontal ribbons
  222.  
  223. (define (create-horizontal-mask ribbon-width
  224.                 ribbon-spacing
  225.                 final-width
  226.                 final-height)
  227.   (create-mask final-width
  228.            final-height
  229.            ribbon-width
  230.            ribbon-spacing
  231.            0
  232.            ribbon-spacing
  233.            (+ (* 2 ribbon-spacing) ribbon-width)
  234.            ribbon-width
  235.            0
  236.            (+ (* 2 ribbon-spacing) ribbon-width)
  237.            ribbon-spacing
  238.            ribbon-width
  239.            (+ ribbon-width ribbon-spacing)
  240.            (+ (* 2 ribbon-spacing) ribbon-width)
  241.            (+ ribbon-width ribbon-spacing)
  242.            ribbon-width))
  243.  
  244. ; Creates the mask for vertical ribbons
  245.  
  246. (define (create-vertical-mask ribbon-width
  247.                   ribbon-spacing
  248.                   final-width
  249.                   final-height)
  250.   (create-mask final-width
  251.            final-height
  252.            ribbon-width
  253.            ribbon-spacing
  254.            (+ (* 2 ribbon-spacing) ribbon-width)
  255.            0
  256.            ribbon-width
  257.            (+ (* 2 ribbon-spacing) ribbon-width)
  258.            ribbon-spacing
  259.            0
  260.            ribbon-width
  261.            ribbon-spacing
  262.            ribbon-spacing
  263.            (+ ribbon-width ribbon-spacing)
  264.            ribbon-width
  265.            (+ ribbon-width ribbon-spacing)))
  266.  
  267. ; Adds a threads layer at a certain orientation to the specified image
  268.  
  269. (define (create-threads-layer img
  270.                   width
  271.                   height
  272.                   length
  273.                   density
  274.                   orientation)
  275.   (let* ((drawable (car (gimp-layer-new img width height RGBA-IMAGE
  276.                     "Threads" 100 NORMAL-MODE)))
  277.      (dense (/ density 100.0)))
  278.     (gimp-image-add-layer img drawable -1)
  279.     (gimp-context-set-background '(255 255 255))
  280.     (gimp-edit-fill drawable BACKGROUND-FILL)
  281.     (plug-in-noisify 1 img drawable FALSE dense dense dense dense)
  282.     (plug-in-c-astretch 1 img drawable)
  283.     (cond ((eq? orientation 'horizontal)
  284.        (plug-in-gauss-rle 1 img drawable length TRUE FALSE))
  285.       ((eq? orientation 'vertical)
  286.        (plug-in-gauss-rle 1 img drawable length FALSE TRUE)))
  287.     (plug-in-c-astretch 1 img drawable)
  288.     drawable))
  289.  
  290. (define (create-complete-weave width
  291.                    height
  292.                    ribbon-width
  293.                    ribbon-spacing
  294.                    shadow-darkness
  295.                    shadow-depth
  296.                    thread-length
  297.                    thread-density
  298.                    thread-intensity)
  299.   (let* ((weave (create-weave width height ribbon-width ribbon-spacing
  300.                   shadow-darkness shadow-depth))
  301.      (w-img (car weave))
  302.      (w-layer (cadr weave))
  303.  
  304.      (h-layer (create-threads-layer w-img width height thread-length
  305.                     thread-density 'horizontal))
  306.      (h-mask (car (gimp-layer-create-mask h-layer ADD-WHITE-MASK)))
  307.  
  308.      (v-layer (create-threads-layer w-img width height thread-length
  309.                     thread-density 'vertical))
  310.      (v-mask (car (gimp-layer-create-mask v-layer ADD-WHITE-MASK)))
  311.  
  312.      (hmask (create-horizontal-mask ribbon-width ribbon-spacing
  313.                     width height))
  314.      (hm-img (car hmask))
  315.      (hm-layer (cadr hmask))
  316.  
  317.      (vmask (create-vertical-mask ribbon-width ribbon-spacing width height))
  318.      (vm-img (car vmask))
  319.      (vm-layer (cadr vmask)))
  320.  
  321.     (gimp-layer-add-mask h-layer h-mask)
  322.     (gimp-selection-all hm-img)
  323.     (gimp-edit-copy hm-layer)
  324.     (gimp-image-delete hm-img)
  325.     (gimp-floating-sel-anchor (car (gimp-edit-paste h-mask FALSE)))
  326.     (gimp-layer-set-opacity h-layer thread-intensity)
  327.     (gimp-layer-set-mode h-layer MULTIPLY-MODE)
  328.  
  329.     (gimp-layer-add-mask v-layer v-mask)
  330.     (gimp-selection-all vm-img)
  331.     (gimp-edit-copy vm-layer)
  332.     (gimp-image-delete vm-img)
  333.     (gimp-floating-sel-anchor (car (gimp-edit-paste v-mask FALSE)))
  334.     (gimp-layer-set-opacity v-layer thread-intensity)
  335.     (gimp-layer-set-mode v-layer MULTIPLY-MODE)
  336.  
  337.     ; Uncomment this if you want to keep the weaving mask image
  338.     ; (gimp-display-new (car (gimp-image-duplicate w-img)))
  339.  
  340.     (list w-img
  341.       (car (gimp-image-flatten w-img)))))
  342.  
  343. ; The main weave function
  344.  
  345. (define (script-fu-weave img
  346.              drawable
  347.              ribbon-width
  348.              ribbon-spacing
  349.              shadow-darkness
  350.              shadow-depth
  351.              thread-length
  352.              thread-density
  353.              thread-intensity)
  354.   (let* ((d-img (car (gimp-drawable-get-image drawable)))
  355.      (d-width (car (gimp-drawable-width drawable)))
  356.      (d-height (car (gimp-drawable-height drawable)))
  357.      (d-offsets (gimp-drawable-offsets drawable))
  358.  
  359.      (weaving (create-complete-weave d-width
  360.                      d-height
  361.                      ribbon-width
  362.                      ribbon-spacing
  363.                      shadow-darkness
  364.                      shadow-depth
  365.                      thread-length
  366.                      thread-density
  367.                      thread-intensity))
  368.      (w-img (car weaving))
  369.      (w-layer (cadr weaving)))
  370.  
  371.     (gimp-context-push)
  372.  
  373.     (gimp-selection-all w-img)
  374.     (gimp-edit-copy w-layer)
  375.     (gimp-image-delete w-img)
  376.     (let ((floating-sel (car (gimp-edit-paste drawable FALSE))))
  377.       (gimp-layer-set-offsets floating-sel
  378.                   (car d-offsets)
  379.                   (cadr d-offsets))
  380.       (gimp-layer-set-mode floating-sel MULTIPLY-MODE)
  381.       (gimp-floating-sel-to-layer floating-sel))
  382.  
  383.     (gimp-displays-flush)
  384.  
  385.     (gimp-context-pop)))
  386.  
  387.  
  388. (script-fu-register "script-fu-weave"
  389.             _"_Weave..."
  390.             "Weave effect like Alien Skin"
  391.             "Federico Mena Quintero"
  392.             "Federico Mena Quintero"
  393.             "June 1997"
  394.             "RGB* GRAY*"
  395.             SF-IMAGE       "Image to Weave"    0
  396.             SF-DRAWABLE    "Drawable to Weave" 0
  397.             SF-ADJUSTMENT _"Ribbon width"      '(30  0 256 1 10 1 1)
  398.             SF-ADJUSTMENT _"Ribbon spacing"    '(10  0 256 1 10 1 1)
  399.             SF-ADJUSTMENT _"Shadow darkness"   '(75  0 100 1 10 1 1)
  400.             SF-ADJUSTMENT _"Shadow depth"      '(75  0 100 1 10 1 1)
  401.             SF-ADJUSTMENT _"Thread length"     '(200 0 256 1 10 1 1)
  402.             SF-ADJUSTMENT _"Thread density"    '(50  0 100 1 10 1 1)
  403.             SF-ADJUSTMENT _"Thread intensity"  '(100 0 100 1 10 1 1))
  404.  
  405. (script-fu-menu-register "script-fu-weave"
  406.              _"<Image>/Script-Fu/Alchemy")
  407.